home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / DOCDEMO.ZIP / COLLECT3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-03  |  2.8 KB  |  120 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { Read a file and add each unique word to a sorted
  9.   string collection. Use the ForEach iterator method
  10.   to traverse the colection and print out each word.
  11. }
  12.  
  13. program Collect3;
  14.  
  15. uses Objects, Memory;
  16.  
  17. const
  18.   FileToRead = 'COLLECT3.PAS';
  19.  
  20. { ********************************** }
  21. { ***********  Iterator  *********** }
  22. { ********************************** }
  23.  
  24. { Given the entire collection, use the ForEach
  25.   iterator to traverse and print all the words. }
  26.  
  27. procedure Print(C: PCollection);
  28.  
  29. { Must be a local, far procedure. Receives one collection
  30.   element at a time--a pointer to a string--to print. }
  31.  
  32. procedure PrintWord(P : PString); far;
  33. begin
  34.   Writeln(P^);
  35. end;
  36.  
  37. begin { Print }
  38.   Writeln;
  39.   Writeln;
  40.   C^.ForEach(@PrintWord);                 { Call PrintWord }
  41. end;
  42.  
  43. { ********************************** }
  44. { **********    Globals    ********* }
  45. { ********************************** }
  46.  
  47. { Abort the program and give a message }
  48.  
  49. procedure Abort(Msg: String);
  50. begin
  51.   Writeln;
  52.   Writeln(Msg);
  53.   Writeln('Program aborting');
  54.   Halt(1);
  55. end;
  56.  
  57. { Given an open text file, read it and return the next word }
  58.  
  59. function GetWord(var F : Text) : String;
  60. var
  61.   S : String;
  62.   C : Char;
  63. begin
  64.   S := '';
  65.   C := #0;
  66.   while not Eof(F) and not (UpCase(C) in ['A'..'Z']) do
  67.     Read(F, C);
  68.   if Eof(F) and (UpCase(C) in ['A'..'Z']) then
  69.     S := C
  70.   else
  71.     while (UpCase(C) in ['A'..'Z']) and not Eof(F) do
  72.     begin
  73.       S := S + C;
  74.       Read(F, C);
  75.     end;
  76.   GetWord := S;
  77. end;
  78.  
  79. { ********************************** }
  80. { **********  Main Program ********* }
  81. { ********************************** }
  82.  
  83. var
  84.   WordList: PCollection;
  85.   WordFile: Text;
  86.   WordFileName: string[80];
  87.   WordRead: String;
  88. begin
  89.   { Initialize collection to hold 10 elements first, then grow by 5's }
  90.   WordList := New(PStringCollection, Init(10, 5));
  91.   if LowMemory then Abort('Out of memory');
  92.  
  93.   { Open file of words }
  94.   if ParamCount = 1 then
  95.     WordFileName := ParamStr(1)
  96.   else
  97.     WordFileName := FileToRead;
  98.   Assign(WordFile, WordFileName);
  99.   {$I-}
  100.   Reset(WordFile);
  101.   {$I+}
  102.   if IOResult <> 0 then
  103.     Abort('Cannot find file "' + WordFileName + '"');
  104.  
  105.   { Read each word into the collection }
  106.   repeat
  107.     WordRead := GetWord(WordFile);
  108.     if WordRead <> '' then
  109.       WordList^.Insert(NewStr(WordRead));
  110.     if LowMemory then Abort('Out of memory');
  111.   until WordRead = '';
  112.   Close(WordFile);
  113.  
  114.   { Display collection contents }
  115.   Print(WordList);
  116.  
  117.   { Delete collection }
  118.   Dispose(WordList, Done);
  119. end.
  120.